home *** CD-ROM | disk | FTP | other *** search
/ Komputer for Alle 1999 #5 / 1999 CD 5 (black).iso / Delphi3 / install / data.z / DBTABLES.INT < prev    next >
Encoding:
Text File  |  1997-08-05  |  31.1 KB  |  850 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {       BDE Data Access                                 }
  6. {                                                       }
  7. {       Copyright (c) 1995,97 Borland International     }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit DBTables;
  12.  
  13. {$R-}
  14.  
  15. interface
  16.  
  17. uses Windows, SysUtils, Graphics, Classes, Controls, Db, DBCommon, Bde, SMIntf,
  18.   StdVCL;
  19.  
  20. const
  21.  
  22. { SQL Trace buffer size }
  23.  
  24.   smTraceBufSize = 32767 + SizeOf(TraceDesc);
  25.  
  26. { TDBDataSet flags }
  27.  
  28.   dbfOpened     = 0;
  29.   dbfPrepared   = 1;
  30.   dbfExecSQL    = 2;
  31.   dbfTable      = 3;
  32.   dbfFieldList  = 4;
  33.   dbfIndexList  = 5;
  34.   dbfStoredProc = 6;
  35.   dbfExecProc   = 7;
  36.   dbfProcDesc   = 8;
  37.  
  38. type
  39.  
  40. { Forward declarations }
  41.  
  42.   TDBError = class;
  43.   TSession = class;
  44.   TDatabase = class;
  45.   TBDEDataSet = class;
  46.   TDBDataSet = class;
  47.   TTable = class;
  48.  
  49. { Generic types }
  50.  
  51.   PFieldDescList = ^TFieldDescList;
  52.   TFieldDescList = array[0..1023] of FLDDesc;
  53.  
  54.   PIndexDescList = ^TIndexDescList;
  55.   TIndexDescList = array[0..63] of IDXDesc;
  56.  
  57.   PSPParamDescList = ^TSPParamDescList;
  58.   TSPParamDescList = array[0..1023] of SPParamDesc;
  59.  
  60. { Exception classes }
  61.  
  62.   EDBEngineError = class(EDatabaseError)
  63.   public
  64.     constructor Create(ErrorCode: DBIResult);
  65.     destructor Destroy; override;
  66.     property ErrorCount: Integer;
  67.     property Errors[Index: Integer]: TDBError;
  68.   end;
  69.  
  70.   ENoResultSet = class(EDatabaseError);
  71.  
  72. { BDE error information type }
  73.  
  74.   TDBError = class
  75.   public
  76.     constructor Create(Owner: EDBEngineError; ErrorCode: DBIResult;
  77.       NativeError: Longint; Message: PChar);
  78.     property Category: Byte;
  79.     property ErrorCode: DBIResult;
  80.     property SubCode: Byte;
  81.     property Message: string;
  82.     property NativeError: Longint;
  83.   end;
  84.  
  85. { TLocale }
  86.  
  87.   TLocale = Pointer;
  88.  
  89. { TBDECallback }
  90.  
  91.   TBDECallbackEvent = function(CBInfo: Pointer): CBRType of Object;
  92.  
  93.   TBDECallback = class
  94.   protected
  95.     function Invoke(CallType: CBType; CBInfo: Pointer): CBRType;
  96.   public
  97.     constructor Create(AOwner: TObject; Handle: hDBICur; CBType: CBType;
  98.       CBBuf: Pointer; CBBufSize: Integer; CallbackEvent: TBDECallbackEvent;
  99.       Chain: Boolean);
  100.     destructor Destroy; override;
  101.   end;
  102.  
  103. { TSessionList }
  104.  
  105.   TSessionList = class(TObject)
  106.   public
  107.     constructor Create;
  108.     destructor Destroy; override;
  109.     property CurrentSession: TSession;
  110.     function FindSession(const SessionName: string): TSession;
  111.     procedure GetSessionNames(List: TStrings);
  112.     function OpenSession(const SessionName: string): TSession;
  113.     property Count: Integer;
  114.     property Sessions[Index: Integer]: TSession; default;
  115.     property List[const SessionName: string]: TSession;
  116.   end;
  117.  
  118. { TSession }
  119.  
  120.   TConfigModes = (cfmVirtual, cfmPersistent, cfmSession);
  121.   TConfigMode = set of TConfigModes;
  122.  
  123.   TPasswordEvent = procedure(Sender: TObject; var Continue: Boolean) of Object;
  124.  
  125.   TDatabaseEvent = (dbOpen, dbClose, dbAdd, dbRemove, dbAddAlias, dbDeleteAlias,
  126.     dbAddDriver, dbDeleteDriver);
  127.  
  128.   TDatabaseNotifyEvent = procedure(DBEvent: TDatabaseEvent; const Param) of object;
  129.  
  130.   TBDEInitProc = procedure(Session: TSession);
  131.  
  132.   TTraceFlag = (tfQPrepare, tfQExecute, tfError, tfStmt, tfConnect,
  133.     tfTransact, tfBlob, tfMisc, tfVendor, tfDataIn, tfDataOut);
  134.  
  135.   TTraceFlags = set of TTraceFlag;
  136.  
  137.   TSession = class(TComponent)
  138.   protected
  139.     procedure Loaded; override;
  140.     procedure ModifyConfigParams(const Path, Node: string; List: TStrings);
  141.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  142.     property OnDBNotify: TDatabaseNotifyEvent;
  143.     property BDEOwnsLoginCbDb: Boolean;
  144.     procedure SetName(const NewName: TComponentName); override;
  145.   public
  146.     constructor Create(AOwner: TComponent); override;
  147.     destructor Destroy; override;
  148.     procedure AddAlias(const Name, Driver: string; List: TStrings);
  149.     procedure AddDriver(const Name: string; List: TStrings);
  150.     procedure AddStandardAlias(const Name, Path, DefaultDriver: string);
  151.     property ConfigMode: TConfigMode;
  152.     procedure AddPassword(const Password: string);
  153.     procedure Close;
  154.     procedure CloseDatabase(Database: TDatabase);
  155.     procedure DeleteAlias(const Name: string);
  156.     procedure DeleteDriver(const Name: string);
  157.     procedure DropConnections;
  158.     function FindDatabase(const DatabaseName: string): TDatabase;
  159.     procedure GetAliasNames(List: TStrings);
  160.     procedure GetAliasParams(const AliasName: string; List: TStrings);
  161.     function GetAliasDriverName(const AliasName: string): string;
  162.     procedure GetConfigParams(const Path, Section: string; List: TStrings);
  163.     procedure GetDatabaseNames(List: TStrings);
  164.     procedure GetDriverNames(List: TStrings);
  165.     procedure GetDriverParams(const DriverName: string; List: TStrings);
  166.     function GetPassword: Boolean;
  167.     procedure GetTableNames(const DatabaseName, Pattern: string;
  168.       Extensions, SystemTables: Boolean; List: TStrings);
  169.     procedure GetStoredProcNames(const DatabaseName: string; List: TStrings);
  170.     function IsAlias(const Name: string): Boolean;
  171.     procedure ModifyAlias(Name: string; List: TStrings);
  172.     procedure ModifyDriver(Name: string; List: TStrings);
  173.     procedure Open;
  174.     function OpenDatabase(const DatabaseName: string): TDatabase;
  175.     procedure RemoveAllPasswords;
  176.     procedure RemovePassword(const Password: string);
  177.     procedure SaveConfigFile;
  178.     property DatabaseCount: Integer;
  179.     property Databases[Index: Integer]: TDatabase;
  180.     property Handle: HDBISES;
  181.     property Locale: TLocale;
  182.     property TraceFlags: TTraceFlags;
  183.   published
  184.     property Active: Boolean default False;
  185.     property AutoSessionName: Boolean default False;
  186.     property KeepConnections: Boolean default True;
  187.     property NetFileDir: string;
  188.     property PrivateDir: string;
  189.     property SessionName: string;
  190.     property SQLHourGlass: Boolean default True;
  191.     property OnPassword: TPasswordEvent;
  192.     property OnStartup: TNotifyEvent;
  193.   end;
  194.  
  195. { TParamList }
  196.  
  197.   TParamList = class(TObject)
  198.   public
  199.     constructor Create(Params: TStrings);
  200.     destructor Destroy; override;
  201.     property Buffer: PChar;
  202.     property FieldCount: Integer;
  203.     property FieldDescs: PFieldDescList;
  204.   end;
  205.  
  206. { TDatabase }
  207.  
  208.   TTransIsolation = (tiDirtyRead, tiReadCommitted, tiRepeatableRead);
  209.  
  210.   TLoginEvent = procedure(Database: TDatabase;
  211.     LoginParams: TStrings) of object;
  212.  
  213.   TDatabase = class(TComponent)
  214.   protected
  215.     procedure Loaded; override;
  216.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  217.   public
  218.     constructor Create(AOwner: TComponent); override;
  219.     destructor Destroy; override;
  220.     procedure ApplyUpdates(const DataSets: array of TDBDataSet);
  221.     procedure Close;
  222.     procedure CloseDataSets;
  223.     procedure Commit;
  224.     procedure FlushSchemaCache(const TableName: string);
  225.     procedure Open;
  226.     procedure Rollback;
  227.     procedure StartTransaction;
  228.     procedure ValidateName(const Name: string);
  229.     property DataSetCount: Integer;
  230.     property DataSets[Index: Integer]: TDBDataSet;
  231.     property Directory: string;
  232.     property Handle: HDBIDB;
  233.     property IsSQLBased: Boolean;
  234.     property InTransaction: Boolean;
  235.     property Locale: TLocale;
  236.     property Session: TSession;
  237.     property Temporary: Boolean;
  238.     property SessionAlias: Boolean;
  239.     property TraceFlags: TTraceFlags;
  240.   published
  241.     property AliasName: string;
  242.     property Connected: Boolean default False;
  243.     property DatabaseName: string;
  244.     property DriverName: string;
  245.     property HandleShared: Boolean default False;
  246.     property KeepConnection: Boolean default True;
  247.     property LoginPrompt: Boolean default True;
  248.     property Params: TStrings;
  249.     property SessionName: string;
  250.     property TransIsolation: TTransIsolation default tiReadCommitted;
  251.     property OnLogin: TLoginEvent;
  252.   end;
  253.  
  254. { TBDEDataSet }
  255.  
  256.   TRecNoStatus = (rnDbase, rnParadox, rnNotSupported);
  257.   TUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApplied);
  258.   TUpdateRecordTypes = set of (rtModified, rtInserted, rtDeleted, rtUnmodified);
  259.   TUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  260.     UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction) of object;
  261.   TUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
  262.     var UpdateAction: TUpdateAction) of object;
  263.   TOnServerYieldEvent = procedure(DataSet: TDataSet; var AbortQuery: Boolean) of object;
  264.   TDataSetUpdateObject = class(TComponent)
  265.   protected
  266.     function GetDataSet: TBDEDataSet; virtual; abstract;
  267.     procedure SetDataSet(ADataSet: TBDEDataSet); virtual; abstract;
  268.     procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;
  269.     property DataSet: TBDEDataSet;
  270.   end;
  271.  
  272.   TKeyIndex = (kiLookup, kiRangeStart, kiRangeEnd, kiCurRangeStart,
  273.     kiCurRangeEnd, kiSave);
  274.  
  275.   PKeyBuffer = ^TKeyBuffer;
  276.   TKeyBuffer = record
  277.     Modified: Boolean;
  278.     Exclusive: Boolean;
  279.     FieldCount: Integer;
  280.     Data: record end;
  281.   end;
  282.  
  283.   PRecInfo = ^TRecInfo;
  284.   TRecInfo = record
  285.     RecordNumber: Longint;
  286.     UpdateStatus: TUpdateStatus;
  287.     BookmarkFlag: TBookmarkFlag;
  288.   end;
  289.  
  290.   TBlobData = string;
  291.   TBlobDataArray = array[0..0] of TBlobData;
  292.   PBlobDataArray = ^TBlobDataArray;
  293.  
  294.   TBDEDataSet = class(TDataSet)
  295.   protected
  296.     procedure ActivateFilters;
  297.     procedure AddFieldDesc(FieldDesc: FLDDesc; Required: Boolean; FieldNo: Word);
  298.     procedure AllocCachedUpdateBuffers(Allocate: Boolean);
  299.     procedure AllocKeyBuffers;
  300.     function AllocRecordBuffer: PChar; override;
  301.     function BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean; override;
  302.     function CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
  303.       Decimals: Integer): Boolean; override;
  304.     function CachedUpdateCallBack(CBInfo: Pointer): CBRType;
  305.     procedure CheckCachedUpdateMode;
  306.     procedure CheckSetKeyMode;
  307.     procedure ClearCalcFields(Buffer: PChar); override;
  308.     procedure CloseCursor; override;
  309.     procedure CloseBlob(Field: TField); override;
  310.     function CreateExprFilter(const Expr: string;
  311.       Options: TFilterOptions; Priority: Integer): HDBIFilter;
  312.     function CreateFuncFilter(FilterFunc: Pointer;
  313.       Priority: Integer): HDBIFilter;
  314.     function CreateHandle: HDBICur; virtual;
  315.     function CreateLookupFilter(Fields: TList; const Values: Variant;
  316.       Options: TLocateOptions; Priority: Integer): HDBIFilter;
  317.     procedure DeactivateFilters;
  318.     procedure DestroyHandle; virtual;
  319.     procedure DestroyLookupCursor; virtual;
  320.     function FindRecord(Restart, GoForward: Boolean): Boolean; override;
  321.     function ForceUpdateCallback: Boolean;
  322.     procedure FreeKeyBuffers;
  323.     procedure FreeRecordBuffer(var Buffer: PChar); override;
  324.     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  325.     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  326.     function GetCanModify: Boolean; override;
  327.     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  328.     function GetIndexField(Index: Integer): TField;
  329.     function GetIndexFieldCount: Integer;
  330.     function GetIsIndexField(Field: TField): Boolean; override;
  331.     function GetKeyBuffer(KeyIndex: TKeyIndex): PKeyBuffer;
  332.     function GetKeyExclusive: Boolean;
  333.     function GetKeyFieldCount: Integer;
  334.     function GetLookupCursor(const KeyFields: string;
  335.       CaseInsensitive: Boolean): HDBICur; virtual;
  336.     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  337.     function GetRecordCount: Integer; override;
  338.     function GetRecNo: Integer; override;
  339.     function GetRecordSize: Word; override;
  340.     function GetStateFieldValue(State: TDataSetState; Field: TField): Variant; override;
  341.     function GetUpdatesPending: Boolean;
  342.     function GetUpdateRecordSet: TUpdateRecordTypes;
  343.     function InitKeyBuffer(Buffer: PKeyBuffer): PKeyBuffer;
  344.     procedure InitRecord(Buffer: PChar); override;
  345.     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
  346.     procedure InternalCancel; override;
  347.     procedure InternalClose; override;
  348.     procedure InternalDelete; override;
  349.     procedure InternalEdit; override;
  350.     procedure InternalFirst; override;
  351.     procedure InternalGotoBookmark(Bookmark: TBookmark); override;
  352.     procedure InternalHandleException; override;
  353.     procedure InternalInitFieldDefs; override;
  354.     procedure InternalInitRecord(Buffer: PChar); override;
  355.     procedure InternalLast; override;
  356.     procedure InternalOpen; override;
  357.     procedure InternalPost; override;
  358.     procedure InternalRefresh; override;
  359.     procedure InternalSetToRecord(Buffer: PChar); override;
  360.     function IsCursorOpen: Boolean; override;
  361.     function LocateRecord(const KeyFields: string; const KeyValues: Variant;
  362.       Options: TLocateOptions; SyncCursor: Boolean): Boolean;
  363.     function MapsToIndex(Fields: TList; CaseInsensitive: Boolean): Boolean;
  364.     procedure OpenCursor(InfoQuery: Boolean); override;
  365.     procedure PostKeyBuffer(Commit: Boolean);
  366.     procedure PrepareCursor; virtual;
  367.     function ProcessUpdates(UpdCmd: DBIDelayedUpdCmd): DBIResult;
  368.     function ResetCursorRange: Boolean;
  369.     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  370.     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  371.     procedure SetCachedUpdates(Value: Boolean);
  372.     function SetCursorRange: Boolean;
  373.     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  374.     procedure SetFilterData(const Text: string; Options: TFilterOptions);
  375.     procedure SetFilterHandle(var Filter: HDBIFilter; Value: HDBIFilter);
  376.     procedure SetFiltered(Value: Boolean); override;
  377.     procedure SetFilterOptions(Value: TFilterOptions); override;
  378.     procedure SetFilterText(const Value: string); override;
  379.     procedure SetIndexField(Index: Integer; Value: TField);
  380.     procedure SetKeyBuffer(KeyIndex: TKeyIndex; Clear: Boolean);
  381.     procedure SetKeyExclusive(Value: Boolean);
  382.     procedure SetKeyFieldCount(Value: Integer);
  383.     procedure SetKeyFields(KeyIndex: TKeyIndex; const Values: array of const);
  384.     procedure SetLinkRanges(MasterFields: TList);
  385.     procedure SetLocale(Value: TLocale);
  386.     procedure SetStateFieldValue(State: TDataSetState; Field: TField; Value: Variant); override;
  387.     procedure SetOnFilterRecord(const Value: TFilterRecordEvent); override;
  388.     procedure SetOnUpdateError(UpdateEvent: TUpdateErrorEvent);
  389.     procedure SetRecNo(Value: Integer); override;
  390.     procedure SetupCallBack(Value: Boolean);
  391.     procedure SetUpdateRecordSet(RecordTypes: TUpdateRecordTypes);
  392.     procedure SetUpdateObject(Value: TDataSetUpdateObject);
  393.     procedure SwitchToIndex(const IndexName, TagName: string);
  394.     function UpdateCallbackRequired: Boolean;
  395.     function YieldCallBack(CBInfo: Pointer): CBRType;
  396.   public
  397.     constructor Create(AOwner: TComponent); override;
  398.     destructor Destroy; override;
  399.     procedure ApplyUpdates;
  400.     function BookmarkValid(Bookmark: TBookmark): Boolean; override;
  401.     procedure Cancel; override;
  402.     procedure CancelUpdates;
  403.     property CacheBlobs: Boolean default True;
  404.     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
  405.     procedure CommitUpdates;
  406.     function ConstraintCallBack(Req: DsInfoReq; var ADataSources: DataSources): DBIResult; stdcall;
  407.     function ConstraintsDisabled: Boolean;
  408.     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
  409.     procedure DisableConstraints;
  410.     procedure EnableConstraints;
  411.     procedure FetchAll;
  412.     procedure FlushBuffers;
  413.     function GetCurrentRecord(Buffer: PChar): Boolean; override;
  414.     procedure GetIndexInfo;
  415.     function Locate(const KeyFields: string; const KeyValues: Variant;
  416.       Options: TLocateOptions): Boolean; override;
  417.     function Lookup(const KeyFields: string; const KeyValues: Variant;
  418.       const ResultFields: string): Variant; override;
  419.     function IsSequenced: Boolean; override;
  420.     procedure Post; override;
  421.     procedure RevertRecord;
  422.     function UpdateStatus: TUpdateStatus;
  423.     procedure Translate(Src, Dest: PChar; ToOem: Boolean);  override;
  424.  
  425.     property ExpIndex: Boolean;
  426.     property Handle: HDBICur;
  427.     property KeySize: Word;
  428.     property Locale: TLocale;
  429.     property UpdateObject: TDataSetUpdateObject;
  430.     property UpdatesPending: Boolean;
  431.     property UpdateRecordTypes: TUpdateRecordTypes;
  432.   published
  433.     property Active;
  434.     property AutoCalcFields;
  435.     property CachedUpdates: Boolean default False;
  436.     property Filter;
  437.     property Filtered;
  438.     property FilterOptions;
  439.     property BeforeOpen;
  440.     property AfterOpen;
  441.     property BeforeClose;
  442.     property AfterClose;
  443.     property BeforeInsert;
  444.     property AfterInsert;
  445.     property BeforeEdit;
  446.     property AfterEdit;
  447.     property BeforePost;
  448.     property AfterPost;
  449.     property BeforeCancel;
  450.     property AfterCancel;
  451.     property BeforeDelete;
  452.     property AfterDelete;
  453.     property BeforeScroll;
  454.     property AfterScroll;
  455.     property OnCalcFields;
  456.     property OnDeleteError;
  457.     property OnEditError;
  458.     property OnFilterRecord;
  459.     property OnNewRecord;
  460.     property OnPostError;
  461.     property OnServerYield: TOnServerYieldEvent;
  462.     property OnUpdateError: TUpdateErrorEvent;
  463.     property OnUpdateRecord: TUpdateRecordEvent;
  464.   end;
  465.  
  466. { TDBDataSet }
  467.  
  468.   TUpdateMode = (upWhereAll, upWhereChanged, upWhereKeyOnly);
  469.   TDBFlags = set of 0..15;
  470.  
  471.   TDBDataSet = class(TBDEDataSet)
  472.   protected
  473.     procedure CloseCursor; override;
  474.     function ConstraintsStored: Boolean;
  475.     procedure Disconnect; virtual;
  476.     function GetProvider: IProvider; virtual;
  477.     procedure OpenCursor(InfoQuery: Boolean); override;
  478.     procedure SetDBFlag(Flag: Integer; Value: Boolean); virtual;
  479.     property DBFlags: TDBFlags;
  480.     property UpdateMode: TUpdateMode default upWhereAll;
  481.   public
  482.     function CheckOpen(Status: DBIResult): Boolean;
  483.     procedure CloseDatabase(Database: TDatabase);
  484.     function OpenDatabase: TDatabase;
  485.     property Database: TDatabase;
  486.     property DBHandle: HDBIDB;
  487.     property DBLocale: TLocale;
  488.     property DBSession: TSession;
  489.     property Provider: IProvider;
  490.   published
  491.     property DatabaseName: string;
  492.     property SessionName: string;
  493.   end;
  494.  
  495. { TTable }
  496.  
  497.   TBatchMode = (batAppend, batUpdate, batAppendUpdate, batDelete, batCopy);
  498.   TTableType = (ttDefault, ttParadox, ttDBase, ttASCII);
  499.   TLockType = (ltReadLock, ltWriteLock);
  500.   TIndexName = type string;
  501.  
  502.   TIndexFiles = class(TStringList)
  503.   public
  504.     constructor Create(AOwner: TTable);
  505.     function Add(const S: string): Integer; override;
  506.     procedure Clear; override;
  507.     procedure Delete(Index: Integer); override;
  508.     procedure Insert(Index: Integer; const S: string); override;
  509.   end;
  510.  
  511.   TTable = class(TDBDataSet)
  512.   protected
  513.     function CreateHandle: HDBICur; override;
  514.     procedure DataEvent(Event: TDataEvent; Info: Longint); override;
  515.     procedure DestroyHandle; override;
  516.     procedure DestroyLookupCursor; override;
  517.     procedure DoOnNewRecord; override;
  518.     procedure EncodeFieldDesc(var FieldDesc: FLDDesc;
  519.       const Name: string; DataType: TFieldType; Size: Word);
  520.     procedure EncodeIndexDesc(var IndexDesc: IDXDesc;
  521.       const Name, Fields: string; Options: TIndexOptions);
  522.     function GetCanModify: Boolean; override;
  523.     function GetDataSource: TDataSource; override;
  524.     function GetHandle(const IndexName, IndexTag: string): HDBICur;
  525.     function GetLanguageDriverName: string;
  526.     function GetLookupCursor(const KeyFields: string;
  527.       CaseInsensitive: Boolean): HDBICur; override;
  528.     procedure InitFieldDefs; override;
  529.     function IsProductionIndex(const IndexName: string): Boolean;
  530.     procedure PrepareCursor; override;
  531.     procedure UpdateIndexDefs; override;
  532.   public
  533.     constructor Create(AOwner: TComponent); override;
  534.     destructor Destroy; override;
  535.     function BatchMove(ASource: TBDEDataSet; AMode: TBatchMode): Longint;
  536.     procedure AddIndex(const Name, Fields: string; Options: TIndexOptions);
  537.     procedure ApplyRange;
  538.     procedure CancelRange;
  539.     procedure CloseIndexFile(const IndexFileName: string);
  540.     procedure CreateTable;
  541.     procedure DeleteIndex(const Name: string);
  542.     procedure DeleteTable;
  543.     procedure EditKey;
  544.     procedure EditRangeEnd;
  545.     procedure EditRangeStart;
  546.     procedure EmptyTable;
  547.     function FindKey(const KeyValues: array of const): Boolean;
  548.     procedure FindNearest(const KeyValues: array of const);
  549.     procedure GetIndexNames(List: TStrings);
  550.     procedure GotoCurrent(Table: TTable);
  551.     function GotoKey: Boolean;
  552.     procedure GotoNearest;
  553.     procedure LockTable(LockType: TLockType);
  554.     procedure OpenIndexFile(const IndexName: string);
  555.     procedure RenameTable(const NewTableName: string);
  556.     procedure SetKey;
  557.     procedure SetRange(const StartValues, EndValues: array of const);
  558.     procedure SetRangeEnd;
  559.     procedure SetRangeStart;
  560.     procedure UnlockTable(LockType: TLockType);
  561.     property IndexDefs: TIndexDefs;
  562.     property IndexFieldCount: Integer;
  563.     property IndexFields[Index: Integer]: TField;
  564.     property KeyExclusive: Boolean;
  565.     property KeyFieldCount: Integer;
  566.     property TableLevel: Integer;
  567.   published
  568.     property Constraints stored ConstraintsStored;
  569.     property Exclusive: Boolean default False;
  570.     property IndexFieldNames: string;
  571.     property IndexFiles: TStrings;
  572.     property IndexName: string;
  573.     property MasterFields: string;
  574.     property MasterSource: TDataSource;
  575.     property ReadOnly: Boolean default False;
  576.     property TableName: TFileName;
  577.     property TableType: TTableType default ttDefault;
  578.     property UpdateMode;
  579.     property UpdateObject;
  580.   end;
  581.  
  582. { TBatchMove }
  583.  
  584.   TBatchMove = class(TComponent)
  585.   protected
  586.     procedure Notification(AComponent: TComponent;
  587.       Operation: TOperation); override;
  588.   public
  589.     constructor Create(AOwner: TComponent); override;
  590.     destructor Destroy; override;
  591.     procedure Execute;
  592.   public
  593.     property ChangedCount: Longint;
  594.     property KeyViolCount: Longint;
  595.     property MovedCount: Longint;
  596.     property ProblemCount: Longint;
  597.   published
  598.     property AbortOnKeyViol: Boolean default True;
  599.     property AbortOnProblem: Boolean default True;
  600.     property CommitCount: Integer default 0;
  601.     property ChangedTableName: TFileName;
  602.     property Destination: TTable;
  603.     property KeyViolTableName: TFileName;
  604.     property Mappings: TStrings;
  605.     property Mode: TBatchMode default batAppend;
  606.     property ProblemTableName: TFileName;
  607.     property RecordCount: Longint default 0;
  608.     property Source: TBDEDataSet;
  609.     property Transliterate: Boolean default True;
  610.   end;
  611.  
  612. { TParam }
  613.  
  614.   TQuery = class;
  615.   TParams = class;
  616.  
  617.   TParamType = (ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult);
  618.  
  619.   TParam = class(TPersistent)
  620.   protected
  621.     procedure AssignParam(Param: TParam);
  622.     procedure AssignTo(Dest: TPersistent); override;
  623.     function GetAsBCD: Currency;
  624.     function GetAsBoolean: Boolean;
  625.     function GetAsDateTime: TDateTime;
  626.     function GetAsFloat: Double;
  627.     function GetAsInteger: Longint;
  628.     function GetAsMemo: string;
  629.     function GetAsString: string;
  630.     function GetAsVariant: Variant;
  631.     function IsEqual(Value: TParam): Boolean;
  632.     function RecBufDataSize: Integer;
  633.     procedure RecBufGetData(Buffer: Pointer; Locale: TLocale);
  634.     procedure SetAsBCD(Value: Currency);
  635.     procedure SetAsBlob(Value: TBlobData);
  636.     procedure SetAsBoolean(Value: Boolean);
  637.     procedure SetAsCurrency(Value: Double);
  638.     procedure SetAsDate(Value: TDateTime);
  639.     procedure SetAsDateTime(Value: TDateTime);
  640.     procedure SetAsFloat(Value: Double);
  641.     procedure SetAsInteger(Value: Longint);
  642.     procedure SetAsMemo(const Value: string);
  643.     procedure SetAsString(const Value: string);
  644.     procedure SetAsSmallInt(Value: LongInt);
  645.     procedure SetAsTime(Value: TDateTime);
  646.     procedure SetAsVariant(Value: Variant);
  647.     procedure SetAsWord(Value: LongInt);
  648.     procedure SetDataType(Value: TFieldType);
  649.     procedure SetText(const Value: string);
  650.   public
  651.     constructor Create(AParamList: TParams; AParamType: TParamType);
  652.     destructor Destroy; override;
  653.     procedure Assign(Source: TPersistent); override;
  654.     procedure AssignField(Field: TField);
  655.     procedure AssignFieldValue(Field: TField; const Value: Variant);
  656.     procedure Clear;
  657.     procedure GetData(Buffer: Pointer);
  658.     function GetDataSize: Integer;
  659.     procedure LoadFromFile(const FileName: string; BlobType: TBlobType);
  660.     procedure LoadFromStream(Stream: TStream; BlobType: TBlobType);
  661.     procedure SetBlobData(Buffer: Pointer; Size: Integer);
  662.     procedure SetData(Buffer: Pointer);
  663.     property AsBCD: Currency;
  664.     property AsBlob: TBlobData;
  665.     property AsBoolean: Boolean;
  666.     property AsCurrency: Double;
  667.     property AsDate: TDateTime;
  668.     property AsDateTime: TDateTime;
  669.     property AsFloat: Double;
  670.     property AsInteger: LongInt;
  671.     property AsSmallInt: LongInt;
  672.     property AsMemo: string;
  673.     property AsString: string;
  674.     property AsTime: TDateTime;
  675.     property AsWord: LongInt;
  676.     property Bound: Boolean;
  677.     property DataType: TFieldType;
  678.     property IsNull: Boolean;
  679.     property Name: string;
  680.     property ParamType: TParamType;
  681.     property Text: string;
  682.     property Value: Variant;
  683.   end;
  684.  
  685. { TParams }
  686.  
  687.   TParams = class(TPersistent)
  688.   protected
  689.     procedure AssignTo(Dest: TPersistent); override;
  690.     procedure DefineProperties(Filer: TFiler); override;
  691.   public
  692.     constructor Create; virtual;
  693.     destructor Destroy; override;
  694.     procedure Assign(Source: TPersistent); override;
  695.     procedure AssignValues(Value: TParams);
  696.     procedure AddParam(Value: TParam);
  697.     procedure RemoveParam(Value: TParam);
  698.     function CreateParam(FldType: TFieldType; const ParamName: string;
  699.       ParamType: TParamType): TParam;
  700.     function Count: Integer;
  701.     procedure Clear;
  702.     procedure GetParamList(List: TList; const ParamNames: string);
  703.     function IsEqual(Value: TParams): Boolean;
  704.     function ParamByName(const Value: string): TParam;
  705.     property Items[Index: Word]: TParam; default;
  706.     property ParamValues[const ParamName: string]: Variant;
  707.   end;
  708.  
  709. { TStoredProc }
  710.  
  711.   PServerDesc = ^TServerDesc;
  712.   TServerDesc = record
  713.     ParamName: string[DBIMAXSPNAMELEN];
  714.     BindType: TFieldType;
  715.   end;
  716.  
  717.   TParamBindMode = (pbByName, pbByNumber);
  718.  
  719.   TStoredProc = class(TDBDataSet)
  720.   protected
  721.     function CreateHandle: HDBICur; override;
  722.     procedure Disconnect; override;
  723.     function GetParamsCount: Word;
  724.     procedure SetDBFlag(Flag: Integer; Value: Boolean); override;
  725.     procedure SetOverLoad(Value: Word);
  726.     procedure SetProcName(const Value: string);
  727.     procedure SetPrepared(Value: Boolean);
  728.     procedure SetPrepare(Value: Boolean);
  729.   public
  730.     constructor Create(AOwner: TComponent); override;
  731.     destructor Destroy; override;
  732.     procedure CopyParams(Value: TParams);
  733.     function DescriptionsAvailable: Boolean;
  734.     procedure ExecProc;
  735.     function ParamByName(const Value: string): TParam;
  736.     procedure Prepare;
  737.     procedure GetResults;
  738.     procedure UnPrepare;
  739.     property ParamCount: Word;
  740.     property StmtHandle: HDBIStmt;
  741.     property Prepared: Boolean;
  742.   published
  743.     property StoredProcName: string;
  744.     property Overload: Word default 0;
  745.     property Params: TParams;
  746.     property ParamBindMode: TParamBindMode default pbByName;
  747.     property UpdateObject;
  748.   end;
  749.  
  750. { TQuery }
  751.  
  752.   TQuery = class(TDBDataSet)
  753.   protected
  754.     function CreateHandle: HDBICur; override;
  755.     procedure Disconnect; override;
  756.     function GetDataSource: TDataSource; override;
  757.     function GetParamsCount: Word;
  758.     procedure SetDBFlag(Flag: Integer; Value: Boolean); override;
  759.   public
  760.     constructor Create(AOwner: TComponent); override;
  761.     destructor Destroy; override;
  762.     procedure ExecSQL;
  763.     function ParamByName(const Value: string): TParam;
  764.     procedure Prepare;
  765.     procedure UnPrepare;
  766.     property Prepared: Boolean;
  767.     property ParamCount: Word;
  768.     property Local: Boolean;
  769.     property StmtHandle: HDBIStmt;
  770.     property Text: string;
  771.     property RowsAffected: Integer;
  772.     property SQLBinary: PChar;
  773.   published
  774.     property Constrained: Boolean default False;
  775.     property Constraints stored ConstraintsStored;
  776.     property DataSource: TDataSource;
  777.     property ParamCheck: Boolean default True;
  778.     property RequestLive: Boolean default False;
  779.     property SQL: TStrings;
  780.     { This property must be listed after the SQL property for Delphi 1.0 compatibility }
  781.     property Params: TParams;
  782.     property UniDirectional: Boolean default False;
  783.     property UpdateMode;
  784.     property UpdateObject;
  785. end;
  786.  
  787. { TUpdateSQL }
  788.  
  789.   TUpdateSQL = class(TDataSetUpdateObject)
  790.   protected
  791.     function GetDataSet: TBDEDataSet; override;
  792.     procedure SetDataSet(ADataSet: TBDEDataSet); override;
  793.     procedure SQLChanged(Sender: TObject);
  794.   public
  795.     constructor Create(AOwner: TComponent); override;
  796.     destructor Destroy; override;
  797.     procedure Apply(UpdateKind: TUpdateKind); override;
  798.     procedure ExecSQL(UpdateKind: TUpdateKind);
  799.     procedure SetParams(UpdateKind: TUpdateKind);
  800.     property DataSet;
  801.     property Query[UpdateKind: TUpdateKind]: TQuery;
  802.     property SQL[UpdateKind: TUpdateKind]: TStrings;
  803.   published
  804.     property ModifySQL: TStrings index 0;
  805.     property InsertSQL: TStrings index 1;
  806.     property DeleteSQL: TStrings index 2;
  807.   end;
  808.  
  809. { TBlobStream }
  810.  
  811.   TBlobStream = class(TStream)
  812.   public
  813.     constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
  814.     destructor Destroy; override;
  815.     function Read(var Buffer; Count: Longint): Longint; override;
  816.     function Write(const Buffer; Count: Longint): Longint; override;
  817.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  818.     procedure Truncate;
  819.   end;
  820.  
  821. function AnsiToNative(Locale: TLocale; const AnsiStr: string;
  822.   NativeStr: PChar; MaxLen: Integer): PChar;
  823. procedure NativeToAnsi(Locale: TLocale; NativeStr: PChar;
  824.   var AnsiStr: string);
  825. procedure AnsiToNativeBuf(Locale: TLocale; Source, Dest: PChar; Len: Integer);
  826. procedure NativeToAnsiBuf(Locale: TLocale; Source, Dest: PChar; Len: Integer);
  827.  
  828. function NativeCompareStr(Locale: TLocale; const S1, S2: string; Len: Integer): Integer;
  829. function NativeCompareStrBuf(Locale: TLocale; const S1, S2: PChar; Len: Integer): Integer;
  830. function NativeCompareText(Locale: TLocale; const S1, S2: string; Len: Integer): Integer;
  831. function NativeCompareTextBuf(Locale: TLocale; const S1, S2: PChar; Len: Integer): Integer;
  832.  
  833. procedure DbiError(ErrorCode: DBIResult);
  834. procedure Check(Status: DBIResult);
  835. procedure RegisterBDEInitProc(const InitProc: TBDEInitProc);
  836.  
  837. const
  838.   { Backward compatibility for TConfigMode }
  839.   cmVirtual = [cfmVirtual];
  840.   cmPersistent = [cfmPersistent];
  841.   cmSession = [cfmSession];
  842.   cmAll = [cfmVirtual, cfmPersistent, cfmSession];
  843.  
  844. var
  845.   Session: TSession;
  846.   Sessions: TSessionList;
  847.   CreateProviderProc: function(DataSet: TDBDataSet): IProvider = nil;
  848.  
  849. implementation
  850.